---
title: "Echo Flesh Dashboard"
author: "Medialab Prado"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
source_code: embed
---
```{r}
# Santiago Mota
# santiago_mota@yahoo.es
# https://www.linkedin.com/in/santiagomota/?locale=en_US
```
```{r setup, include=FALSE}
library(plotly)
library(maps)
knitr::opts_chunk$set(message = FALSE)
```
Row {data-height=500}
-----------------------------------------------------------------------------
### Mapa1
```{r}
# Unemployment
# This example modifies code from Hadley Wickham (https://gist.github.com/hadley/233134)
# It also uses data from Nathan Yau's flowingdata site (http://flowingdata.com/)
unemp <- read.csv("http://datasets.flowingdata.com/unemployment09.csv")
names(unemp) <- c("id", "state_fips", "county_fips", "name", "year",
"?", "?", "?", "rate")
unemp$county <- tolower(gsub(" County, [A-Z]{2}", "", unemp$name))
unemp$state <- gsub("^.*([A-Z]{2}).*$", "\\1", unemp$name)
county_df <- map_data("county")
names(county_df) <- c("long", "lat", "group", "order", "state_name", "county")
county_df$state <- state.abb[match(county_df$state_name, tolower(state.name))]
county_df$state_name <- NULL
state_df <- map_data("state")
choropleth <- merge(county_df, unemp, by = c("state", "county"))
choropleth <- choropleth[order(choropleth$order), ]
choropleth$rate_d <- cut(choropleth$rate, breaks = c(seq(0, 10, by = 2), 35))
# provide a custom tooltip to plotly with the county name and actual rate
choropleth$text <- with(choropleth, paste0("County: ", name, "Rate: ", rate))
p <- ggplot(choropleth, aes(long, lat, group = group)) +
geom_polygon(aes(fill = rate_d, text = text),
colour = alpha("white", 1/2), size = 0.2) +
geom_polygon(data = state_df, colour = "white", fill = NA) +
scale_fill_brewer(palette = "PuRd") + theme_void()
# just show the text aesthetic in the tooltip
ggplotly(p, tooltip = "text")
```
### Mapa2
```{r}
# library(ggmap)
# addr <- "3 Carlos Munoz Ruiz, Alcobendas, Madrid, Spain"
# loc <- as.numeric(geocode(addr))
# lbl <- data.frame(lon=loc[1], lat=loc[2], text=addr)
# map <- get_map(location=loc, zoom=15, source="google")
# p <- ggmap(map)
# p <- p + geom_point(data=lbl, aes(x=lon, y=lat), size=5, colour="orange")
# p <- p + geom_point(data=lbl, aes(x=lon, y=lat), size=3, colour="red")
# p <- p + geom_text(data=lbl, aes(x=lon, y=lat, label=text),
# size=5, colour="blue", hjust=0.5, vjust=5)
# p
library(sp)
library(rgdal)
library(deldir)
library(dplyr)
library(ggplot2)
library(ggthemes)
library(leaflet)
library(rgeos)
library(htmltools)
# Now we'll [ab]use the data from the Arc Map example:
flights <- read.csv("http://bl.ocks.org/mbostock/raw/7608400/flights.csv",
stringsAsFactors=FALSE)
airports <- read.csv("http://bl.ocks.org/mbostock/raw/7608400/airports.csv",
stringsAsFactors=FALSE)
# Since the D3 example cheats and only uses the continental US (CONUS) we'll do
# the same and we'll also filter out only those airports mentioned in the flights
# data and get the total # of incoming/outgoing flights for each airport:
conus <- state.abb[!(state.abb %in% c("AK", "HI"))]
airports <- filter(airports,
state %in% conus,
iata %in% union(flights$origin, flights$destination))
orig <- select(count(flights, origin), iata=origin, n1=n)
dest <- select(count(flights, destination), iata=destination, n2=n)
airports <- left_join(airports,
select(mutate(left_join(orig, dest),
tot=n1+n2),
iata, tot)) %>%
filter(!is.na(tot))
# Since we're going to initially plot polygons in ggplot (and, eventually, in
# leaflet), we'll need to work with Spatial objects, so let's make those
# airport lat/lon pairs into a SpatialPointsDataFrame:
vor_pts <- SpatialPointsDataFrame(cbind(airports$longitude,
airports$latitude),
airports, match.ID=TRUE)
# The deldir function returns a pretty complex object. Thankfully, the authors
# of the package realized that one might just want the polygons from the
# computation and pre-made a function: tile.list for computing/extracting them.
# Those polygons aren't, however, closed and we really want to keep the airport
# data associatd with them, so we need to close the polygons and associate the
# data. Since we're likely going to repeat this task, let's make it a
# (very badly named) function:
SPointsDF_to_voronoi_SPolysDF <- function(sp) {
# tile.list extracts the polygon data from the deldir computation
vor_desc <- tile.list(deldir(sp@coords[,1], sp@coords[,2]))
lapply(1:(length(vor_desc)), function(i) {
# tile.list gets us the points for the polygons but we
# still have to close them, hence the need for the rbind
tmp <- cbind(vor_desc[[i]]$x, vor_desc[[i]]$y)
tmp <- rbind(tmp, tmp[1,])
# now we can make the Polygon(s)
Polygons(list(Polygon(tmp)), ID=i)
}) -> vor_polygons
# hopefully the caller passed in good metadata!
sp_dat <- sp@data
# this way the IDs _should_ match up w/the data & voronoi polys
rownames(sp_dat) <- sapply(slot(SpatialPolygons(vor_polygons),
'polygons'),
slot, 'ID')
SpatialPolygonsDataFrame(SpatialPolygons(vor_polygons),
data=sp_dat)
}
# Before we can make the plots, we need to put the Spatial objects into the
# proper form for ggplot2 (and get the U.S. state map):
vor <- SPointsDF_to_voronoi_SPolysDF(vor_pts)
vor_df <- fortify(vor)
states <- map_data("state")
# Now we can have some fun. Let's try to mimic the D3 example map as closely as
# possible. We'll lay down the CONUS map, add a points layer for the the
# airports, sizing & styling them just like the D3 example. Note that we order
# the points so that the smallest ones appear on top (so we can still see them).
# We'll then lay down our newly created Voronoi layer. We'll also use the same
# projection (Albers) that the D3 examples uses:
# First we'll need some additional packages:
library(leaflet)
library(rgeos)
library(htmltools)
# And, we'll also need a U.S. shapefile (which we simplify since the polygons
# are pretty detailed and that's not necessary for this vis):
url <- "http://eric.clst.org/wupl/Stuff/gz_2010_us_040_00_500k.json"
fil <- "gz_2010_us_040_00_500k.json"
if (!file.exists(fil)) download.file(url, fil, cacheOK=TRUE)
states_m <- readOGR("gz_2010_us_040_00_500k.json",
"OGRGeoJSON", verbose=FALSE)
states_m <- subset(states_m,
!NAME %in% c("Alaska", "Hawaii", "Puerto Rico"))
dat <- states_m@data # gSimplify whacks the data bits
states_m <- SpatialPolygonsDataFrame(gSimplify(states_m, 0.05,
topologyPreserve=TRUE),
dat, FALSE)
# The leaflet vis idiom is similar to the ggplot idiom. I'm using a base tile
# layer since I was too lazy to figure out how to change the leaflet default
# gray background map color. The map polygons are added, then the circles/bubbles
# (note that you work in meters with addCircles which lets leaflet scale the
# bubbles as you zoom in/out). Finally, the Voronoi layer is added. I kept the
# stroke visible purely for demonstration purposes. You need to keep fill=TRUE
# otherwise the Voronoi layer won't get click/hover events and once I figure out
# how to trigger popups on hover and use a static popup layer, this will let
# users hover around the map to get the underlying airport flight information.
leaflet(width=900, height=650) %>%
# base map
addProviderTiles("Hydda.Base") %>%
addPolygons(data=states_m,
stroke=TRUE, color="white", weight=1, opacity=1,
fill=TRUE, fillColor="#cccccc", smoothFactor=0.5) %>%
# airports layer
addCircles(data=arrange(airports, desc(tot)),
lng=~longitude, lat=~latitude,
radius=~sqrt(tot)*5000, # size is in m for addCircles O_o
color="white", weight=1, opacity=1,
fillColor="steelblue", fillOpacity=1) %>%
# voronoi (click) layer
addPolygons(data=vor,
stroke=TRUE, color="#a5a5a5", weight=0.25,
fill=TRUE, fillOpacity = 0.0,
smoothFactor=0.5,
popup=sprintf("Total In/Out: %s",
as.character(vor@data$tot)))
```
Row {data-height=500}
-----------------------------------------------------------------------------
### Analisis
```{r}
pretest2 <- round( rnorm( n=5000, mean=80, sd=5) )
posttest2 <- round( pretest2 + rnorm( n=5000, mean=3, sd=3) )
pretest2 [pretest2 > 100] <- 100
posttest2[posttest2 > 100] <- 100
temp <- data.frame(pretest2,posttest2)
ggplot(temp, aes(pretest2, posttest2)) +
geom_hex( bins=30 )
```
### Series temporales
```{r}
# https://www.r-bloggers.com/interactive-time-series-with-dygraphs/
# install.packages("dygraphs")
library(dygraphs)
dygraph(nhtemp) %>%
dyRangeSelector()
```
